home *** CD-ROM | disk | FTP | other *** search
- unit Bde01;
-
- interface
-
- uses
- SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
- Forms, Dialogs, ExtCtrls, DBCtrls, Grids, DBGrids, DB, DBTables, Menus,
- StdCtrls, DbiTypes, DbiProcs;
-
- type
- TForm2 = class(TForm)
- DataSource1: TDataSource;
- Table1: TTable;
- DBGrid1: TDBGrid;
- DBNavigator1: TDBNavigator;
- MainMenu1: TMainMenu;
- Panel2: TPanel;
- Label1: TLabel;
- Edit1: TEdit;
- Label2: TLabel;
- Edit2: TEdit;
- File1: TMenuItem;
- Gotorecord1: TMenuItem;
- Moveby1: TMenuItem;
- N1: TMenuItem;
- Exit1: TMenuItem;
- SetPrivDir: TMenuItem;
- N2: TMenuItem;
- procedure DataSource1DataChange(Sender: TObject; Field: TField);
- procedure Gotorecord1Click(Sender: TObject);
- procedure Moveby1Click(Sender: TObject);
- procedure Exit1Click(Sender: TObject);
- procedure SetPrivDirClick(Sender: TObject);
- private
- { Private declarations }
- public
- { Public declarations }
- end;
-
- var
- Form2: TForm2;
-
- function GetRecNo(ATable: TTable): LongInt;
-
- implementation
- uses CpyRen, ChDir;
-
- {$R *.DFM}
-
- function GetRecNo(ATable: TTable): LongInt;
- var Props: CURProps;
- RProps: RECProps;
- begin
- Result := -1;
-
- Check(DbiGetCursorProps(ATable.Handle, Props));
- ATable.UpdateCursorPos;
- Check(DbiGetRecord(ATable.Handle, dbiNOLOCK, nil, @RProps));
-
- if (Props.iSeqNums = 1) then
- Result := RProps.iSeqNum
- else
- if (Props.iSeqNums = 0) then
- Result := RProps.iPhyRecNum
- end;
-
- procedure TForm2.DataSource1DataChange(Sender: TObject; Field: TField);
- var RecNo: LongInt;
- TranInfo: XInfo;
- begin
- Table1.UpdateCursorPos;
- Edit1.Text := IntToStr(GetRecNo(Table1));
- end;
-
- procedure TForm2.Gotorecord1Click(Sender: TObject);
- begin
- Check(DbiSetToSeqNo(Table1.Handle, StrToInt(Edit1.Text)));
- Table1.Refresh;
- end;
-
- procedure TForm2.Moveby1Click(Sender: TObject);
- begin
- Table1.UpdateCursorPos;
- Check(DbiGetRelativeRecord(Table1.Handle, StrToInt(Edit2.Text), dbiNoLock, nil, nil));
- Table1.Refresh;
- end;
-
- procedure TForm2.Exit1Click(Sender: TObject);
- begin
- Close;
- end;
-
- procedure TForm2.SetPrivDirClick(Sender: TObject);
- var szDir: array[0..DBIMAXPATHLEN] of char;
- begin
- try
- Table1.DisableControls;
- Table1.Close;
- ChDirDlg := TChDirDlg.Create(Self);
- if ChDirDlg.ShowModal = mrOK then
- begin
- StrPCopy(szDir, ChDirDlg.Label1.Caption);
- Check(DbiSetPrivateDir(szDir));
- end;
- except
- Application.HandleException(Self);
- end;
- ChDirDlg.Release;
- Table1.Open;
- Table1.EnableControls;
- end;
-
- end.
-